Celestin Apprentice 2

home *** CD-ROM | disk | FTP | other *** search

/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Applications / NIH Image 1.55 / Source / Image.p < prev next >

Wrap

Text File | 1994-04-26 | 68.5 KB | 2,693 lines | [TEXT/PJMM]

program Image; {NIH Image is a public domain program for the Macintosh for acquiring, } {enhancing, analyzing, editing, printing, and animating 8-bit images.} {Version 1.55, 25 April1994} {Developed using Think Pascal 4.0.2} {Note: requires at least a 5MB partition for Think Pascal.} {Author :} {Wayne Rasband} {National Institutes of Health} {Internet: wayne@helix.nih.gov} {Anonymous ftp: zippy.nimh.nih.gov} {Phone: 301-496-4957} uses QuickDraw, Palettes, PrintTraps, Globals, Utilities, Initialization, File1, File2, Analysis, Graphics, {} Edit, Filters, Camera, User, Macros1, Macros2, Stacks, Background, {,UMacroDef, UMacroRun} Lut, Projection, Plugins, Text, Math, Registration; {Turn off automatic toolbox initialization.} {$I-} {PROCEDURE MacsBug; inline $a9ff;} procedure UpdateOptionsMenu; var CheckIt: boolean; i: integer; begin with info^ do begin CheckItem(OptionsMenuH, GrayscaleItem, (LutMode = Grayscale) or (LutMode = CustomGrayscale)); if LutMode <> PseudoColor then ColorTable := CustomTable; CheckItem(ColorTablesMenuH, SystemPaletteItem, ColorTable = AppleDefault); CheckItem(ColorTablesMenuH, Pseudo20Item, ColorTable = Pseudo20); CheckItem(ColorTablesMenuH, Pseudo32Item, ColorTable = Pseudo32); CheckItem(ColorTablesMenuH, RainbowItem, ColorTable = Rainbow); CheckItem(ColorTablesMenuH, Fire1Item, ColorTable = Fire1); CheckItem(ColorTablesMenuH, Fire2Item, ColorTable = Fire2); CheckItem(ColorTablesMenuH, IceItem, ColorTable = Ice); CheckItem(ColorTablesMenuH, GraysItem, ColorTable = Grays); CheckItem(ColorTablesMenuH, SpectrumItem, ColorTable = Spectrum); SetMenuItem(OptionsMenuH, ScaleToFitItem, info <> NoInfo); CheckIt := ScaleToFitWindow; CheckItem(OptionsMenuH, ScaleToFitItem, CheckIt); CheckItem(OptionsMenuH, ThresholdItem, Thresholding); CheckItem(OptionsMenuH, SliceItem, DensitySlicing); SetMenuItem(OptionsMenuH, PropagateItem, nPics > 1); end; end; procedure UpdateEnhanceMenu; var ShowItems: boolean; i: integer; str: str255; begin ShowItems := Info <> NoInfo; for i := SmoothItem to FilterItem do SetMenuItem(EnhanceMenuH, i, ShowItems); with info^ do if (LutMode = GrayScale) or (LutMode = CustomGrayscale) or DensitySlicing then SetItem(EnhanceMenuH, ApplyItem, 'Apply LUT') else SetItem(EnhanceMenuH, ApplyItem, 'Convert to Grayscale'); if CurrentWindow = TextKind then SetItem(EnhanceMenuH, ConvolveItem, 'Convolve') else SetItem(EnhanceMenuH, ConvolveItem, 'Convolve…'); for i := BinaryItem to FixColorsItem do SetMenuItem(EnhanceMenuH, i, ShowItems); NumToString(BinaryCount, str); str := concat('Set Count[', str, ']…'); SetItem(BinaryMenuH, SetCountItem, str); NumToString(BinaryIterations, str); str := concat('Set Iterations[', str, ']…'); SetItem(BinaryMenuH, IterationsItem, str); CheckItem(BackgroundMenuH, FasterItem, FasterBackgroundSubtraction); NumToString(BallRadius, str); str := concat('Set Radius[', str, ']…'); SetItem(BackgroundMenuH, RadiusItem, str); end; procedure UpdateSpecialMenu; var ShowItems: boolean; begin ShowItems := Info <> NoInfo; SetMenuItem(SpecialMenuH, SaveBlankFieldItem, ShowItems); SetMenuItem(SpecialMenuH, PhotoModeItem, ShowItems); if CurrentWindow = TextKind then SetItem(SpecialMenuH, LoadMacrosItem, 'Load Macros from Window') else SetItem(SpecialMenuH, LoadMacrosItem, 'Load Macros…') end; procedure UpdateStacksMenu; var ShowItems: boolean; isStack: boolean; begin ShowItems := Info <> NoInfo; SetMenuItem(StacksMenuH, StackFromWindowsItem, nPics > 0); isStack := info^.StackInfo <> nil; SetMenuItem(StacksMenuH, WindowsFromStackItem, isStack); SetMenuItem(StacksMenuH, AddSliceItem, isStack); SetMenuItem(StacksMenuH, DeleteSliceItem, isStack); SetMenuItem(StacksMenuH, NextSliceItem, isStack); SetMenuItem(StacksMenuH, PreviousSliceItem, isStack); SetMenuItem(StacksMenuH, MakeMovieItem, ShowItems); SetMenuItem(StacksMenuH, CaptureFramesItem, ShowItems); SetMenuItem(StacksMenuH, AnimateItem, isStack); SetMenuItem(StacksMenuH, AverageSlicesItem, isStack); SetMenuItem(StacksMenuH, MakeMontageItem, isStack); SetMenuItem(StacksMenuH, RegisterItem, isStack); SetMenuItem(StacksMenuH, CaptureColorItem, ShowItems); SetMenuItem(StacksMenuH, RGBToColorItem, isStack); SetMenuItem(StacksMenuH, ColorToRGBItem, ShowItems and (not isStack)); SetMenuItem(StacksMenuH, RGBToHSVItem, isStack); SetMenuItem(StacksMenuH, ProjectItem, isStack); SetMenuItem(StacksMenuH, ResliceItem, isStack); SetMenuItem(StacksMenuH, ResliceOptionsItem, isStack); end; function AboutFilter (d: DialogPtr; var event: EventRecord; var ItemHit: integer): boolean; { simple filter proc for about box -- must be at top level! % } begin if (event.what in [MouseDown, KeyDown, AutoKey]) then begin AboutFilter := true; ItemHit := OK; end else begin AboutFilter := false; ItemHit := 0; end; end; procedure AboutUProc (d: DialogPtr; item: integer); { About box user proc -- must be at top level!} var s: str255; saveport: grafptr; VersInfo: str255; begin getport(saveport); setport(d); if (item = MemItem) then begin NumToString(FreeMem div 1024, s); s := concat(s, 'K free'); DrawSItem(MemItem, Geneva, 9, d, s); end else if (item = VersItem) then begin RealToString(version / 100.0, 4, 2, VersInfo); VersInfo := concat('Version ', VersInfo); DrawSItem(VersItem, Geneva, 9, d, VersInfo); end; setport(saveport); end; procedure DoAbout; {About Box by David Powell} var i: integer; d: dialogptr; midscreen: point; r: rect; h: handle; itype: integer; begin d := getnewdialog(AboutID, nil, pointer(-1)); if (d <> nil) then begin SetPort(d); GetDItem(d, VersItem, itype, h, r); SetDItem(d, VersItem, itype, @AboutUProc, r); GetDItem(d, MemItem, itype, h, r); SetDItem(d, MemItem, itype, @AboutUProc, r); ShowWindow(d); repeat ModalDialog(@aboutfilter, i); until (i = OK); DisposDialog(d); FlushEvents(EveryEvent, 0); end; end; procedure DoPreferences; const BufferSizeID = 4; ScaleArithmeticID = 6; ScaleConvolutionsID = 7; InvertValuesID = 8; InvertYID = 9; LW6ID = 10; SwitchingID = 11; HighlightID = 12; CreatorID = 14; var mylog: DialogPtr; item, i: integer; SaveScale, SaveLW6, SaveScaleC: boolean; SaveInvertValues, SaveInvertY: boolean; SaveBufferSize: LongInt; SaveCreator: packed array[1..4] of char; begin InitCursor; SaveBufferSize := BufferSize; SaveScale := ScaleArithmetic; SaveInvertY := InvertYCoordinates; SaveLW6 := DriverHalftoning; SaveScaleC := ScaleConvolutions; SaveCreator := TextCreator; mylog := GetNewDialog(6000, nil, pointer(-1)); SetDNum(MyLog, BufferSizeID, BufferSize div 1024); SetDialogItem(mylog, ScaleArithmeticID, ord(ScaleArithmetic)); SetDialogItem(mylog, ScaleConvolutionsID, ord(ScaleConvolutions)); SetDialogItem(mylog, InvertYID, ord(InvertYCoordinates)); SetDialogItem(mylog, LW6ID, ord(not DriverHalftoning)); SetDialogItem(mylog, SwitchingID, ord(SwitchLUTOnSuspend)); SetDialogItem(mylog, HighlightID, ord(HighlightMode)); SaveInvertValues := InvertPixelValues; if InvertPixelValues then SetDialogItem(mylog, InvertValuesID, 1); SetDString(mylog, CreatorID, TextCreator); repeat ModalDialog(nil, item); if item = BufferSizeID then begin BufferSize := GetDNum(MyLog, BufferSizeID) * 1024; if BufferSize < 1 then begin beep; BufferSize := 1; SetDNum(MyLog, BufferSizeID, BufferSize); end; end; if item = ScaleArithmeticID then begin ScaleArithmetic := not ScaleArithmetic; SetDialogItem(mylog, ScaleArithmeticID, ord(ScaleArithmetic)); if PasteControl <> nil then DrawPasteControl end; if item = ScaleConvolutionsID then begin ScaleConvolutions := not ScaleConvolutions; SetDialogItem(mylog, ScaleConvolutionsID, ord(ScaleConvolutions)); end; if item = InvertValuesID then begin InvertPixelValues := not InvertPixelValues; SetDialogItem(mylog, InvertValuesID, ord(InvertPixelValues)); end; if item = InvertYID then begin InvertYCoordinates := not InvertYCoordinates; SetDialogItem(mylog, InvertYID, ord(InvertYCoordinates)); end; if item = LW6ID then begin DriverHalftoning := not DriverHalftoning; SetDialogItem(mylog, LW6ID, ord(not DriverHalftoning)); end; if item = SwitchingID then begin SwitchLUTOnSuspend := not SwitchLUTOnSuspend; SetDialogItem(mylog, SwitchingID, ord(SwitchLUTOnSuspend)); end; if item = HighlightID then begin HighlightMode := not HighlightMode; SetDialogItem(mylog, HighlightID, ord(HighlightMode)); LoadLUT(info^.ctable); end; if item = CreatorID then TextCreator := GetDString(mylog, item); until (item = ok) or (item = cancel); DisposDialog(mylog); if item = cancel then begin BufferSize := SaveBufferSize; ScaleArithmetic := SaveScale; ScaleConvolutions := SaveScaleC; InvertYCoordinates := SaveInvertY; DriverHalftoning := SaveLW6; if PasteControl <> nil then DrawPasteControl; TextCreator := SaveCreator; end else with info^ do begin if InvertPixelValues and (SaveInvertValues = false) then InvertgrayLevels else if (InvertPixelValues = false) and SaveInvertValues then begin DensityCalibrated := false; DrawLabels('', '', ''); end; UpdateTitleBar; end; if BufferSize <> SaveBufferSIze then PutMessage('You must "Record Preferences" and restart before the Undo and Clipboard buffer size change will take effect.'); end; procedure UpdateWindowsMenu; var i, n: integer; begin for i := NextImageItem to CascadeImagesItem do SetMenuItem(WindowsMenuH, i, nPics > 1); for i := SelectToolsItem to SelectResultsItem do CheckItem(WindowsMenuH, i, false); SetMenuItem(WindowsMenuH, SelectHistogramItem, HistoWindow <> nil); SetMenuItem(WindowsMenuH, SelectPlotItem, PlotWindow <> nil); SetMenuItem(WindowsMenuH, SelectResultsItem, ResultsWindow <> nil); for i := 1 to nTextWindows do CheckItem(WindowsMenuH, WindowsMenuItems - 1 + i, false); for i := 1 to nPics do CheckItem(WindowsMenuH, WindowsMenuItems + nTextWindows + i, false); if PasteControl = nil then SetItem(WindowsMenuH, PasteControlItem, 'Show Paste Control') else SetItem(WindowsMenuH, PasteControlItem, 'Hide Paste Control'); if CurrentKind < 0 then exit(UpdateWindowsMenu); {System Window} case CurrentKind of ToolKind: CheckItem(WindowsMenuH, SelectToolsItem, true); MapKind: CheckItem(WindowsMenuH, SelectGrayMapItem, true); LUTKind: CheckItem(WindowsMenuH, SelectLutItem, true); InfoKind: CheckItem(WindowsMenuH, SelectInfoItem, true); HistoKind: CheckItem(WindowsMenuH, SelectHistogramItem, true); ProfilePlotKind, CalibrationPLotKind: CheckItem(WindowsMenuH, SelectPlotItem, true); ResultsKind: CheckItem(WindowsMenuH, SelectResultsItem, true); TextKind: begin if TextInfo <> nil then CheckItem(WindowsMenuH, WindowsMenuItems - 1 + TextInfo^.WindowNum, true); end; PicKind: CheckItem(WindowsMenuH, WindowsMenuItems + nTextWindows + info^.PicNum, true); otherwise end; end; procedure CloseAll; FORWARD; procedure DoNew; const ImageID = 4; TextID = 5; WidthID = 6; HeightID = 7; TitleID = 8; var mylog: DialogPtr; item, i: integer; SaveWidth, SaveHeight: integer; SaveTitle: string[31]; okay, OpenImage: boolean; procedure SetButtons; begin SetDialogItem(mylog, ImageID, ord(OpenImage)); SetDialogItem(mylog, TextID, ord(not OpenImage)); end; begin InitCursor; OpenImage := true; SaveWidth := NewPicWidth; SaveHeight := NewPicHeight; SaveTitle := NewTitle; mylog := GetNewDialog(180, nil, pointer(-1)); SetButtons; SetDNum(MyLog, WidthID, NewPicWidth); SelIText(MyLog, WidthID, 0, 32767); SetDNum(MyLog, HeightID, NewPicHeight); SetDString(MyLog, TitleID, NewTitle); repeat ModalDialog(nil, item); if item = ImageID then begin OpenImage := true; SetButtons; end; if item = TextID then begin OpenImage := false; SetButtons; end; if item = WidthID then begin NewPicWidth := GetDNum(MyLog, WidthID); if (NewPicWidth < 0) or (NewPicWidth > MaxPicSize) then begin NewPicWidth := SaveWidth; SetDNum(MyLog, WidthID, NewPicWidth); end; end; if item = HeightID then begin NewPicHeight := GetDNum(MyLog, HeightID); if (NewPicHeight < 0) or (NewPicHeight > MaxPicSize) then begin NewPicHeight := SaveHeight; SetDNum(MyLog, HeightID, NewPicHeight); end; end; until (item = ok) or (item = cancel); if item = ok then NewTitle := GetDString(MyLog, TitleID); DisposDialog(mylog); if NewPicWidth < 32 then NewPicWidth := 32; if odd(NewPicWidth) then NewPicWidth := NewPicWidth + 1; if NewPicHeight < 16 then NewPicHeight := 16; if item = cancel then begin NewPicWidth := SaveWidth; NewPicHeight := SaveHeight; NewTitle := SaveTitle; exit(DoNew); end; if OpenImage then begin okay := NewPicWindow(NewTitle, NewPicWidth, NewPicHeight); if okay then if info^.PixMapSize > UndoBufSize then PutWarning; end else okay := MakeNewTextWindow(NewTitle, 500, 400); end; procedure DoMenuEvent (MenuChoice: LongInt); var MenuID, MenuItem, i, ignore: integer; name, str: str255; dna, RefNum: integer; ItemName: str255; FontName: str255; ok, isSelection: boolean; NewStyle: StyleItem; t: FateTable; {Only needed for MakeSkeleton} SaveBFInfo: InfoPtr; begin MenuID := HiWord(MenuChoice); MenuItem := LoWord(MenuChoice); case MenuID of AppleMenu: begin if MenuItem = 1 then DoAbout else begin GetItem(GetMHandle(AppleMenu), MenuItem, name); ignore := OpenDeskAcc(name) end; end; FileMenu: begin StopDigitizing; isInsertionPoint := false; case MenuItem of NewItem: DoNew; OpenItem: ok := DoOpen('', 0); ImportItem: ok := ImportFile('', 0); {-} CloseItem: if OptionKeyWasDown and (CurrentWindow <> TextKInd) then CloseAll else DoClose; SaveItem: if OptionKeyWasDown and (info^.StackInfo = nil) and (CurrentWindow <> TextKind) then SaveAll else SaveFile; SaveAsItem: case CurrentWindow of TextKind: SaveTextAs; ResultsKind: Export('', 0); otherwise SaveAs('', 0); end; ExportItem: Export('', 0); {-} RecordPreferencesItem: SaveSettings; RevertItem: with info^ do if DataType = EightBits then RevertToSaved else RescaleToEightBits; DuplicateItem: ok := Duplicate('', false); GetInfoItem: GetInfo; {-} SetHalftoneItem: SetHalftone; PageSetupItem: DoPageSetup; PrintItem: Print(true); {-} QuitItem: finished := true; end; end; AcquireMenu: RunAcqPlugIn(MenuItem); ExportMenu: RunExportPlugIn(MenuItem); EditMenu: begin StopDigitizing; GetItem(GetMHandle(EditMenu), MenuItem, ItemName); if not SystemEdit(MenuItem - 1) then case MenuItem of UndoItem: DoUndo; {-} CutItem: DoCut; CopyItem: DoCopy; PasteItem: DoPaste; ClearItem: DoClear; {-} FillItem: if CurrentWindow = TextKind then DoFind else SetupOperation(FillItem); InvertItem, DrawBoundaryItem: SetupOperation(MenuItem); DrawScaleItem: DrawScale; {-} SelectAllItem: with info^ do if RoiShowing and EqualRect(RoiRect, PicRect) then KillRoi else SelectAll(true); ScaleAndRotateItem: ScaleAndRotate; {-} RotateLeftItem: Rotate(RotateLeft); RotateRightItem: Rotate(RotateRight); FlipVerticalItem: FlipOrRotate(FlipVertical); FlipHorizontalItem: FlipOrRotate(FlipHorizontal); {-} UnzoomItem: Unzoom; ShowClipboardItem: ShowClipboard; end; end; OptionsMenu: begin case MenuItem of GrayscaleItem: ResetGrayMap; LutOptionsItem: DoLutOptions; {-} PreferencesItem: DoPreferences; PlotOptionsItem: DoProfilePlotOptions; ScaleToFitItem: ScaleToFit; ThresholdItem: begin if DensitySlicing then DisableDensitySlice; if Info^.Thresholding then DisableThresholding else begin SetupLutUndo; AutoThreshold; end; end; SliceItem: if DensitySlicing then DisableDensitySlice else begin if info^.thresholding then DisableThresholding; EnableDensitySlice; end; end; end; ColorTablesMenu: SwitchColorTables(MenuItem, true); FontMenu: begin GetItem(FontMenuH, MenuItem, FontName); GetFNum(FontName, CurrentFontID); DisplayText(true); if CurrentWindow = TextKind then ChangeFontOrSize; end; SizeMenu: begin case MenuItem of 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12: CurrentSize := GetFontSize(MenuItem); end; DisplayText(true); if IsInsertionPoint then UpdatePicWindow; if CurrentWindow = TextKind then ChangeFontOrSize; end; StyleMenu: begin case MenuItem of 1: CurrentStyle := []; 2, 3, 4, 5, 6: begin case MenuItem of TxBold: NewStyle := Bold; TxItalic: NewStyle := Italic; TxUnderLine: NewStyle := Underline; TxOutLine: NewStyle := Outline; TxShadow: NewStyle := Shadow; end; if NewStyle in CurrentStyle then CurrentStyle := CurrentStyle - [NewStyle] else CurrentStyle := CurrentStyle + [NewStyle]; end; LeftItem: TextJust := teJustLeft; CenterItem: TextJust := teJustCenter; RightItem: TextJust := teJustRight; NoBackgroundItem: TextBack := NoBack; WithBackgroundItem: TextBack := WithBack; end; {case} DisplayText(true); end; PropagateMenu: DoPropagate(MenuItem); EnhanceMenu: begin StopDigitizing; SetupUndo; case MenuItem of SmoothItem: if OptionKeyDown then Filter(UnweightedAvg, 0, t) else Filter(WeightedAvg, 0, t); SharpenItem: Filter(fsharpen, 0, t); ShadowItem: Filter(fshadow, 0, t); EdgeDetectItem: Filter(EdgeDetect, 0, t); ReduceNoiseItem: Filter(ReduceNoise, 0, t); DitherItem: Filter(Dither, 0, t); ConvolveItem: if CurrentWindow = TextKind then ConvolveUsingText else Convolve('', 0); {-} ImageMathItem: DoImageMath; ApplyItem: ApplyLookupTable; EnhanceItem: EnhanceContrast; EqualizeItem: EqualizeHistogram; FixColorsItem: if not isBinaryImage then FixColors; end; end; FilterMenu: RunFilterPlugin(menuItem); BinaryMenu: case MenuItem of MakeBinaryItem: MakeBinary; ErosionItem: DoErosion; DilationItem: DoDilation; OpeningItem: DoOpening; ClosingItem: DoClosing; SetCountItem: SetBinaryCount; IterationsItem: SetIterations; OutlineItem: filter(OutlineFilter, 0, t); SkeletonizeItem: MakeSkeleton; end; ArithmeticMenu: DoArithmetic(MenuItem, 0); BackgroundMenu: DoBackgroundMenuEvent(MenuItem); AnalyzeMenu: begin if MenuItem <> HistogramItem then StopDigitizing; SetupUndo; case MenuItem of MeasureItem: Measure; AnalyzeItem: AnalyzeParticles; ShowItem: ShowResults; OptionsItem: DoMeasurementOptions; HistogramItem: DoHistogram; PlotItem: PlotDensityProfile; PlotSurfaceItem: PlotSurface; {-} SetScaleItem: SetScale; CalibrateItem: Calibrate; RedoItem: RedoMeasurement; DeleteItem: DeleteMeasurement; ResetItem: ResetCounter; RestoreItem: RestoreRoi; MarkItem: MarkSelection(mCount); end; end; SpecialMenu: begin case MenuItem of StartItem: StartDigitizing; AverageItem: AverageFrames; SaveBlankFieldItem: begin SaveBFInfo := BlankFieldInfo; BlankFieldInfo := nil; {Prevents shading correction.} StopDigitizing; BlankFieldInfo := SaveBFInfo; SaveBlankField; end; VideoControlItem: if VideoControl = nil then ShowVideoControl else SelectWindow(VideoControl); PhotoModeItem: PhotoMode; LoadMacrosItem: begin LoadMacros; UnloadSeg(@LoadMacros) end; otherwise if MenuItem >= FirstMacroItem then RunMacro(MenuItem - FirstMacroItem + 1); end; end; StacksMenu: begin StopDigitizing; case MenuItem of StackFromWindowsItem: MakeStack; WindowsFromStackItem: MakeWindowsFromStack; AddSliceItem: ok := AddSlice(true); DeleteSliceItem: DeleteSlice; NextSliceItem, PreviousSliceItem: ShowNextSlice(MenuItem); MakeMovieItem: MakeMovie; CaptureFramesItem: CaptureFrames; AnimateItem: Animate; AverageSlicesItem: AverageSlices; MakeMontageItem: MakeMontage; CaptureColorItem: CaptureColor; RGBToColorItem: ConvertRGBToEightBitColor(false); ColorToRGBItem: ConvertEightBitColorToRGB; RGBToHSVItem: ConvertRGBToHSV; RegisterItem: DoRegister; ProjectItem: Project; ResliceItem: Reslice; ResliceOptionsItem: DoResliceOptions; otherwise beep end; end; WindowsMenu: begin if MenuItem <> PasteControlItem then StopDigitizing; case MenuItem of NextImageItem: ShowNextImage; StackImagesItem: StackImages; CascadeImagesItem: CascadeImages; PasteControlItem: if PasteControl = nil then ShowPasteControl else ignore := CloseAWindow(PasteControl); {-} SelectToolsItem: SelectWindow(ToolWindow); SelectGrayMapItem: SelectWindow(MapWindow); SelectLutItem: SelectWindow(LUTWindow); SelectInfoItem: SelectWindow(InfoWindow); SelectHistogramItem: if HistoWindow <> nil then SelectWindow(HistoWindow); SelectPlotItem: if PlotWindow <> nil then SelectWindow(PlotWindow); SelectResultsItem: if ResultsWindow <> nil then SelectWindow(ResultsWindow); {-} otherwise if MenuItem <= (WindowsMenuItems - 1 + nTextWindows) then SelectWindow(TextWindow[MenuItem - (WindowsMenuItems - 1)]) else SelectWindow(PicWindow[MenuItem - (WindowsMenuItems + nTextWindows)]); end; end; UserMenu: DoUserMenuEvent(MenuItem); otherwise end; HiliteMenu(0); RoiUpdateTime := 0; end; procedure DoFreehand; var finish: point; event: EventRecord; wright, wbottom: integer; b: boolean; begin SetPort(info^.wptr); PenPat(pat[PatIndex]); PenSize(1, 1); with info^.wptr^.PortRect do begin wright := right; wbottom := bottom; end; while Button do begin GetMouse(finish); with finish do begin if h < 0 then h := 0; if v < 0 then v := 0; if h > wright then h := wright; if v > wbottom then v := wbottom; if (xCoordinates^[nCoordinates] <> h) or (yCoordinates^[nCoordinates] <> v) then begin if nCoordinates < MaxCoordinates then nCoordinates := nCoordinates + 1 else beep; LineTo(h, v); xCoordinates^[nCoordinates] := h; yCoordinates^[nCoordinates] := v; wait(1); end; {if mouse has moved} end; {with} end; {while Button} end; procedure DoPolygon (start: point); var Finish, OldFinish: point; finished, DoubleClick, done: boolean; ticks, MouseUpTime, LastMouseUpTime: LongInt; wright, wbottom: integer; StartRect: rect; MouseDown, MouseUpEvent: boolean; begin DrawLabels('DX:', 'DY:', 'Length:'); SetPort(info^.wptr); PenMode(PatXor); PenSize(1, 1); if CurrentTool = PolygonTool then begin Pt2Rect(Start, Start, StartRect); InsetRect(StartRect, -4, -4); FrameRect(StartRect); end else SetRect(StartRect, 0, 0, 0, 0); finish := start; finished := false; with info^.wptr^.PortRect do begin wright := right; wbottom := bottom; end; MouseUpTime := 0; done := false; MouseUpEvent := false; MouseDown := button; repeat ShowDxDy(0, 0); repeat OldFinish := finish; GetMouse(finish); with finish do begin if h < 0 then begin h := 0; done := CurrentTool = LineTool; end; if v < 0 then begin v := 0; done := CurrentTool = LineTool; end; if h > wright then begin h := wright; done := CurrentTool = LineTool; end; if v > wbottom then begin v := wbottom; done := CurrentTool = LineTool; end; end; if not EqualPt(finish, OldFinish) then begin ticks := TickCount; repeat until TickCount <> ticks; MoveTo(start.h, start.v); LineTo(OldFinish.h, OldFinish.v); MoveTo(start.h, start.v); LineTo(finish.h, finish.v); ShowDxDy(abs(finish.h - start.h), abs(finish.v - start.v)); end; if button <> MouseDown then begin MouseUpEvent := not button; MouseDown := button; end; until MouseUpEvent; MouseUpEvent := false; LastMouseUpTime := MouseUpTime; MouseUpTime := TickCount; DoubleClick := ((MouseUpTime - LastMouseUpTime) < GetDblTime) and EqualPt(start, finish); if nCoordinates < MaxCoordinates then nCoordinates := nCoordinates + 1 else beep; xCoordinates^[nCoordinates] := finish.h; yCoordinates^[nCoordinates] := finish.v; start := finish; Finished := (PtInRect(finish, StartRect) or DoubleClick or done) and (nCoordinates > 2); until finished; FlushEvents(EveryEvent, 0); end; procedure MakePolygon (event: EventRecord); var Start: point; i: integer; begin with info^ do begin start := event.where; SetPort(wptr); PenNormal; xCoordinates^[1] := Start.h; yCoordinates^[1] := Start.v; nCoordinates := 1; MoveTo(start.h, start.v); case CurrentTool of FreehandTool: begin DoFreehand; with Start do LineTo(h, v); end; PolygonTool: DoPolygon(start); end; if nCoordinates > 2 then begin ConvertCoordinates; if CurrentTool = PolygonTool then MakeOutline(PolygonRoi) else MakeOutline(FreehandRoi); end else begin KillRoi; UpdatePicWindow; end; end; {with} end; procedure MakeLineRoi (event: EventRecord); var Start: point; begin start := event.where; with Info^ do begin if PixMapSize > UndoBufSize then begin beep; exit(MakeLineRoi); end; WhatToUndo := NothingToUndo; measuring := false; if LOIType = Straight then begin DoObject(LineObj, event); RoiType := LineRoi; MakeRegion; RoiShowing := true; SetupUndo; exit(MakeLineRoi); end; SetPort(wptr); PenNormal; MoveTo(start.h, start.v); xCoordinates^[1] := Start.h; yCoordinates^[1] := Start.v; nCoordinates := 1; end; {with info} if LOIType = Freehand then DoFreehand else DoPolygon(start); if nCoordinates > 1 then case LoiType of freehand: MakeNonStraightLineRoi(FreeLineRoi); segmented: MakeNonStraightLineRoi(SegLineRoi); end else with info^ do begin RoiShowing := false; RoiType := NoRoi; UpdatePicWindow; end; end; procedure DoProfilePlot (event: EventRecord); var ulength, clength: real; begin with Info^ do begin WhatToUndo := NothingToUndo; measuring := false; DoObject(LineObj, event); RoiType := LineRoi; MakeRegion; RoiShowing := true; SetupUndo; GetLengthOrPerimeter(ulength, clength); if ulength > 0 then PlotDensityProfile end; end; procedure DoMouseDownInWindow (event: EventRecord; WhichWindow: WindowPtr); {Handles mouse down events in the content region of image windows.} var r: rect; str: str255; hloc, vloc: integer; tool: ToolType; start: Point; begin if (WindowPeek(WhichWindow)^.WindowKind <> PicKind) then exit(DoMouseDownInWindow); SetPort(info^.wptr); if Digitizing then if (CurrentTool <> MagnifyingGlass) and (CurrentTool <> Grabber) then StopDigitizing; GlobalToLocal(event.where); IsInsertionPoint := false; with info^ do if RoiShowing then if EqualRect(RoiRect, PicRect) and (SelectionMode = NewSelection) then {if Select All} if not (OpPending and (CurrentOp = PasteOp)) then begin KillRoi; MouseState := NotInRoi; exit(DoMouseDownInWindow); end; if MouseState <> NotInRoi then exit(DoMouseDownInWindow); if SpaceBarDown and (CurrentTool <> TextTool) then tool := grabber else tool := CurrentTool; if (SelectionMode = NewSelection) and not ((tool = MagnifyingGlass) or (tool = Grabber)) then KillRoi; SetupUndo; case tool of SelectionTool: DoObject(SelectionRect, event); PolygonTool, FreehandTool: MakePolygon(event); OvalSelectionTool: DoObject(SelectionOval, event); LineTool: MakeLineRoi(event); MagnifyingGlass: ZoomIn(event); Grabber: Scroll(event); Pencil, Brush, Eraser: DoBrush(event); SprayCanTool: DoSprayCan; Ruler: if OptionKeyDown or ControlKeyDown then PutMessage('Use the line selection tool and Measure to measure path lengths.') else begin DoObject(LineObj, event); WhatToUndo := UndoEdit; end; PaintBucket: DoFill(event); TextTool: DoText(event.where); PlotTool: DoProfilePlot(event); PickerTool: if BitAnd(Event.modifiers, OptionKey) = OptionKey then GetBackgroundColor(event) else GetForegroundColor(event); CrossHairTool: DoPoints(event); AngleTool: FindAngle(event); Wand: begin if Digitizing then StopDigitizing; start := event.where; ScreenToOffscreen(start); AutoOutline(start); end; otherwise beep; end; end; procedure DoPopupMenusInTools; var Item: integer; ticks: LongInt; procedure DrawCurrentTool; begin InvalRect(ToolRect[CurrentTool]); BeginUpdate(ToolWindow); DrawTools; EndUpdate(ToolWindow); end; begin DrawCurrentTool; ticks := TickCount; repeat until (not button) or (TickCount > ticks + 20); if button and (TickCount > (ticks + 20)) then with ToolRect[CurrentTool] do begin Item := PopUpMenu(LineToolMenuH, left, top, ord(LOIType) + 1); case Item of 1: LOIType := Straight; 2: LOIType := Freehand; 3: LOIType := Segmented; otherwise end; DrawCurrentTool; end; end; procedure DoMouseDownInTools (loc: point); {Handles mouse down events in the tool palette.} var r: rect; OddTool, DoubleClick: boolean; ToolNum, i: integer; begin SetPort(ToolWindow); GlobalToLocal(loc); if loc.v <= StartOfLines then begin PreviousTool := CurrentTool; OddTool := loc.h < tmiddle; ToolNum := (loc.v div tmiddle) * 2; if not OddTool then ToolNum := ToolNum + 1; CurrentTool := ToolType(ToolNum); isSelectionTool := (CurrentTool = SelectionTool) or (CurrentTool = OvalSelectionTool) or (CurrentTool = PolygonTool) or (CurrentTool = FreehandTool) or (CurrentTool = LineTool); DoubleClick := (TickCount - ToolTime) < GetDblTime; ToolTime := TickCount; InvalRect(ToolRect[CurrentTool]); InvalRect(ToolRect[PreviousTool]); IsInsertionPoint := false; if DoubleClick and (CurrentTool = PreviousTool) then case CurrentTool of MagnifyingGlass: Unzoom; SelectionTool: begin StopDigitizing; SelectAll(true); end; SprayCanTool: SetSprayCanSize; Brush: SetBrushSize; LineTool: SetScale; PolygonTool: DoMeasurementOptions; FreehandTool: Calibrate; ruler: SetLineWidth; PlotTool: DoProfilePlotOptions; Eraser: if info <> NoInfo then begin KillRoi; SetupUndo; WhatToUndo := UndoClear; StopDigitizing; SelectAll(false); DoOperation(eraseOp); end; LutTool, Wand: if DensitySlicing then DisableDensitySlice else begin if Info^.Thresholding then ResetGrayMap; if OptionKeyDown then AutoDensitySlice; EnableDensitySlice; end; PickerTool: if info^.LutMode <> PseudoColor then begin {Switch to pseudocolor mode} DisableDensitySlice; UpdateLUT; CurrentTool := LutTool; isSelectionTool := false; InvalRect(ToolRect[CurrentTool]); end else ResetGrayMap; otherwise end; {case} if (not isSelectionTool) and (CurrentTool <> MagnifyingGlass) and (CurrentTool <> Grabber) and (CurrentTool <> Wand) then KillRoi; if not DoubleClick and (CurrentTool = LineTool) then KillRoi; with info^ do if RoiShowing then if EqualRect(RoiRect, PicRect) and not isSelectionTool then {if Select All} KillRoi; if (CurrentTool = SelectionTool) or (CurrentTool = CrossHairTool) then begin InfoMessage := ''; if mCount > 0 then ShowInfo; end; RoiMode := MoveMode; if CurrentTool = LineTool then begin if Button then DoPopUpMenusInTools; if (LoiType = Straight) and (LineWidth <> 1) then begin LineWidth := 1; UpdateRoiLineWidth; ShowLineWidth; end; end; end else begin for i := 1 to nLineTypes do begin r := lines[i]; with r do begin left := left - 13; top := top - 2; right := right + 2; bottom := bottom + 2; end; if i = 1 then with r do top := top - 7; if PtInRect(loc, r) then begin with lines[i] do LineWidth := bottom - top; LineIndex := i; end; end; EraseRect(CheckRect); InvalRect(CheckRect); UpdateRoiLineWidth; end; end; procedure ScaleToFitScreen; var trect: rect; ignore: boolean; begin with info^ do begin MoveWindow(wptr, PicLeftBase, PicTopBase, true); SetRect(trect, 0, 0, ScreenWidth, ScreenHeight); ScaleImageWindow(trect); wrect := trect; SizeWindow(wptr, trect.right, trect.bottom, true); end; end; procedure DoDrag (WhichWindow: WindowPtr; loc: point); var WinRect, DragBounds, trect: rect; kind: integer; begin kind := WindowPeek(WhichWindow)^.WindowKind; if kind = PicKind then begin if info^.PictureType = ScionType then exit(DoDrag); with info^ do begin {Save window location} GetWindowRect(wptr, trect); savehloc := trect.left; savevloc := trect.top; end; PicLeft := PicLeftBase; PicTop := PicTopBase; end; DragBounds := ScreenBits.bounds; DragWindow(WhichWindow, loc, DragBounds); if (info^.PictureType = FrameGrabberType) or OptionKeyDown then begin GetWindowRect(WhichWindow, trect); MoveWindow(WhichWindow, band(trect.left, $fffc), trect.top, true); end; if WhichWindow = InfoWindow then ShowInfo; if WhichWindow = ResultsWindow then begin GetWindowRect(WhichWindow, trect); ResultsTop := trect.top; ResultsLeft := trect.left; end; end; procedure UpdateMenus; begin OptionKeyWasDown := OptionKeyDown; CurrentKind := CurrentWindow; UpdateFileMenu; UpdateEditMenu; UpdateOptionsMenu; UpdateTextItems; UpdateEnhanceMenu; UpdateAnalysisMenu; UpdateSpecialMenu; UpdateStacksMenu; UpdateWindowsMenu; end; function HMGetBalloons: BOOLEAN; inline $303C, $0003, $A830; function BalloonHelp: boolean; begin if not System7 then begin BalloonHelp := false; exit(BalloonHelp); end; BalloonHelp := HMGetBalloons; end; procedure DoMouseDown (event: EventRecord); var WhichWindow: WindowPtr; ThePart, ignore, kind: integer; trect: rect; begin ThePart := FindWindow(event.where, WhichWindow); kind := WindowPeek(WhichWindow)^.WindowKind; case ThePart of InDesk: ; InMenuBar: begin UpdateMenus; DoMenuEvent(MenuSelect(event.where)); end; InSysWindow: SystemClick(Event, WhichWindow); InContent: begin RoiUpdateTime := 0; if WhichWindow = ToolWindow then begin if BalloonHelp then SelectWindow(ToolWindow); DoMouseDownInTools(event.where); exit(DoMouseDown); end; if WhichWindow = MapWindow then begin if BalloonHelp then SelectWindow(MapWindow); DoMouseDownInMap; exit(DoMouseDown) end; if WhichWindow = LUTWindow then begin if BalloonHelp then SelectWindow(LUTWindow); DoMouseDownInLUT(event); exit(DoMouseDown) end; if WhichWindow = PasteControl then begin DoMouseDownInPasteControl(event.where); exit(DoMouseDown) end; if WhichWindow = ResultsWindow then begin DoMouseDownInResults(event.where); exit(DoMouseDown) end; if kind = TextKind then begin DoMouseDownInText(Event, WhichWindow); exit(DoMouseDown) end; if WhichWindow <> FrontWindow then SelectWindow(WhichWindow) else DoMouseDownInWindow(Event, WhichWindow); end; InDrag: DoDrag(WhichWindow, event.where); InGrow: DoGrow(WhichWindow, event); InGoAway: if TrackGoAway(WhichWindow, event.where) then if OptionKeyDown and (kind = PicKind) then CloseAll else begin if WhichWindow <> VideoControl then StopDigitizing; ignore := CloseAWindow(WhichWindow); end; InZoomIn, InZoomOut: with info^ do case WindowState of NormalWindow: begin if digitizing then exit(DoMouseDown); ScaleToFit; if ScaleToFitWindow then ScaleToFitScreen; end; TiledSmall, TiledSmallScaled: begin if WindowState = TiledSmall then begin ScaleToFitWindow := true; WindowState := TiledBig; end else WindowState := TiledBigScaled; savewrect := wrect; SaveSrcRect := SrcRect; SaveMagnification := magnification; GetWindowRect(wptr, trect); savehloc := trect.left; savevloc := trect.top; ScaleToFitScreen; UpdatePicWindow; end; TiledBig: begin ScaleToFitWindow := false; WindowState := TiledSmall; wrect := savewrect; SrcRect := SaveSrcRect; magnification := SaveMagnification; HideWindow(wptr); SizeWindow(wptr, wrect.right, wrect.bottom, true); MoveWindow(wptr, savehloc, savevloc, true); ShowWindow(wptr); UpdatePicWindow; magnification := 1.0; UpdateTitleBar; end; TiledBigScaled: begin WindowState := TiledSmallScaled; wrect := savewrect; SrcRect := PicRect; HideWindow(wptr); SizeWindow(wptr, wrect.right, wrect.bottom, true); MoveWindow(wptr, savehloc, savevloc, true); ShowWindow(wptr); UpdatePicWindow; if PicRect.right <> 0 then magnification := wrect.right / PicRect.right; UpdateTitleBar; end; end; {case WindowState} end; {case thePart} end; procedure NudgeRoi (key: integer); var dh, dv: integer; begin with info^ do begin if not RoiShowing then exit(NudgeRoi); case key of LeftArrow: begin dh := -1; dv := 0 end; RightArrow: begin dh := 1; dv := 0 end; UpArrow: begin dh := 0; dv := -1 end; DownArrow: begin dh := 0; dv := 1 end; end; if OptionKeyDown then begin if RoiType = RectRoi then with RoiRect do begin right := right + dh; if right < left + 2 then right := left + 2; bottom := bottom + dv; if bottom < top + 2 then bottom := top + 2; MakeRegion; end else beep; end else begin OffsetRgn(roiRgn, dh, dv); RoiRect := roiRgn^^.rgnBBox; end; RoiNudged := true; RoiUpdateTime := 0; end; end; procedure DoKeyDown (event: EventRecord); var ch: char; ich, KeyCode: integer; begin Ch := chr(band(Event.message, CharCodeMask)); ich := ord(ch); {ShowMessage(long2str(ich));} KeyCode := bsr(band(Event.message, KeyCodeMask), 8); if BitAnd(Event.modifiers, CmdKey) = CmdKey then begin UpdateMenus; if OptionKeyWasDown then begin case KeyCode of 1: ch := 'S'; 3: ch := 'F'; 5: ch := 'G'; 8: ch := 'C'; 9: ch := 'V'; 13: ch := 'W'; 17: ch := 'T'; 24: ch := '='; 35: ch := 'P'; 44: ch := '/'; end; end; DoMenuEvent(MenuKey(Ch)); exit(DoKeyDown) end; if CurrentWindow = TextKind then begin DoKeyDownInText(ch); exit(DoKeyDown) end; with info^ do if (CurrentTool = TextTool) and IsInsertionPoint and (ord(ch) <> FunctionKey) then DrawCharacter(ch) else if ch = BackSpace then DoClear else if RoiShowing and (ich >= LeftArrow) and (ich <= DownArrow) then NudgeRoi(ich) else if (StackInfo <> nil) and (ch in ['<', ',', chr(PageUp), '>', '.', chr(PageDown), chr(HomeKey), chr(EndKey)]) then begin if ch in ['<', ',', chr(PageUp)] then ShowNextSlice(PreviousSliceItem) else if ch in ['>', '.', chr(PageDown)] then ShowNextSlice(NextSliceItem) else if (ich = HomeKey) or (ich = EndKey) then ShowFirstOrLastSlice(ich); end else if nMacros > 0 then RunKeyMacro(ch, KeyCode); end; procedure DoActivate (event: EventRecord); var WhichWindow: WindowPtr; Activating, SwitchingWindows, isOK: boolean; I, kind: integer; NewInfo: InfoPtr; begin WhichWindow := WindowPtr(event.message); kind := WindowPeek(WhichWindow)^.WindowKind; Activating := odd(event.modifiers); case kind of PicKind: begin if Activating then begin NewInfo := pointer(WindowPeek(WhichWindow)^.RefCon); SwitchingWindows := NewInfo <> Info; if SwitchingWindows then begin StopDigitizing; SaveRoi; DisableDensitySlice; end; Info := NewInfo; if SwitchingWindows then ActivateWindow; Measuring := false; with info^ do begin LoadLUT(cTable); DrawMap; if digitizing and HighlightSaturatedPixels then HighlightPixels; GenerateValues; if not DensityCalibrated then DrawLabels('', '', ''); end; {with} end else KillOperation; {Deactivate} end; ResultsKind: UpdateResultsWindow; TextKind: ActivateTextWindow(WhichWindow, Activating); otherwise end; {case} if not activating then begin WhichWindow := FrontWindow; if WhichWindow <> nil then begin kind := WindowPeek(WhichWindow)^.WindowKind; if kind < 0 then ConvertClipboard; {DA has become active} end; end; end; procedure DoUpdate (event: EventRecord); var WhichWindow: WindowPtr; SaveInfo: InfoPtr; kind: integer; begin WhichWindow := WindowPtr(event.message); kind := WindowPeek(WhichWindow)^.WindowKind; BeginUpdate(WhichWindow); case kind of Pickind: begin SaveInfo := info; Info := pointer(WindowPeek(WhichWindow)^.RefCon); if not digitizing then begin UpdatePicWindow; DrawMyGrowIcon(info^.wptr); end; info := SaveInfo; end; ToolKind: DrawTools; MapKind: DrawMap; LutKind: DrawLUT; InfoKind: begin DrawLabels('', '', ''); if (mCount > 0) or (InfoMessage <> '') then ShowInfo; end; HistoKind: DrawHistogram; ProfilePlotKind, CalibrationPlotKind: UpdatePlotWindow; ResultsKind: UpdateResultsWindow; PasteControlKind: DrawPasteControl; TextKind: UpdateTextWindow(WhichWindow); end; EndUpdate(WhichWindow); end; procedure DoDiskInsert (event: EventRecord); { Process disk insertion event, check for damaged or uninitialized disks. } var p: point; intjunk: integer; begin if (HiWord(event.message) <> NoErr) then begin DiLoad; SetPt(p, 100, 80); intjunk := DiBadMount(p, event.message); DiUnload; end; end; procedure DoDialogEvent (event: EventRecord); {Handles modeless dialog box events} var isItemHit: boolean; theDialog: DialogPtr; ItemHit: integer; ch: char; begin if (Event.what = KeyDown) and (BitAnd(Event.modifiers, CmdKey) = CmdKey) then begin UpdateMenus; ch := chr(band(Event.message, CharCodeMask)); DoMenuEvent(MenuKey(ch)); exit(DoDialogEvent); end; isItemHit := DialogSelect(event, theDialog, ItemHit); if isItemHit and (theDialog = VideoControl) then DoVideoControl(ItemHit); end; function HandleEvents: boolean; const mousemovedmessage = $FA; SuspendResumeMessage = 1; ResumeMask = 1; var Event: EventRecord; result: boolean; theDialog: DialogPtr; ItemHit: integer; SleepTicks: LongInt; okay: boolean; begin if Digitizing then SleepTicks := 0 else SleepTicks := 2; if WaitNextEvent(EveryEvent, Event, SleepTicks, nil) then begin if isDialogEvent(event) then DoDialogEvent(event) else case Event.what of KeyDown, AutoKey: DoKeyDown(Event); MouseDown: DoMouseDown(Event); ActivateEvt: DoActivate(Event); DiskEvt: DoDiskInsert(Event); UpdateEvt: DoUpdate(Event); app4Evt: case BSR(event.message, 24) of MouseMovedMessage: ; SuspendResumeMessage: if BAND(event.message, ResumeMask) <> 0 then begin{Resume event} if SwitchLUTOnSuspend and (WhatToUndo = UndoLUT) then begin UndoLUTChange; WhatToUndo := NothingToUndo; end else LoadLUT(info^.ctable); end else begin {Suspend event} KillOperation; ConvertClipboard; if SwitchLUTOnSuspend then begin SetupLUTUndo; okay := LoadCLUTResource(AppleDefaultCLUT); end; end; end; otherwise {Do nothing} end; {case} HandleEvents := true end else HandleEvents := false; end; procedure ShowInsertionPoint; var tRect: rect; Loc: point; height, imag: integer; begin if (not isInsertionPoint) or (info = NoInfo) then exit(ShowInsertionPoint); if CurrentWindow <> PicKind then exit(ShowInsertionPoint); if (TickCount mod (BlinkTime * 2)) < BlinkTime then exit(ShowInsertionPoint); Loc := InsertionPoint; OffscreenToScreen(loc); with info^, tRect do begin SetPort(wptr); imag := trunc(magnification + 0.5); height := CurrentSize * imag; height := height - height div 4; left := loc.h; bottom := loc.v - imag + 1; top := bottom - height; right := left + 1; PenNormal; PenSize(imag, imag); PenMode(PatXor); FrameRect(tRect); ticks := TickCount + 3; repeat until TickCount > ticks; FrameRect(tRect); end; end; procedure UndoRoi; var SrcPtr, DstPtr: ptr; offset, ByteCount, tTop, tBottom: LongInt; tRect: rect; begin with info^ do begin if PixMapSize <> CurrentUndoSize then exit(UndoRoi); tRect := RoiRect; if RoiType = LineRoi then InsetRect(tRect, -RoiHandleSize, -RoiHandleSize); with tRect do begin tTop := top; tBottom := bottom; if tTop < 0 then tTop := 0; if tTop > PicRect.bottom then tTop := PicRect.bottom; if tBottom < 0 then tBottom := 0; if tBottom > PicRect.bottom then tBottom := PicRect.bottom; end; offset := tTop * BytesPerRow; if offset < 0 then offset := 0; SrcPtr := ptr(ord4(UndoBuf) + offset); DstPtr := ptr(ord4(PicBaseAddr) + offset); ByteCount := (tBottom - tTop) * BytesPerRow; BlockMove(SrcPtr, DstPtr, ByteCount); end; end; procedure GetLineHandles (var LeftHandle, MiddleHandle, RightHandle: rect); var offset1, offset2, xcenter, ycenter, x1, y1, x2, y2: integer; rx1, ry1, rx2, ry2: real; begin offset1 := RoiHandleSize div 2; offset2 := offset1 + 1; GetLoi(rx1, ry1, rx2, ry2); x1 := trunc(rx1); y1 := trunc(ry1); x2 := trunc(rx2); y2 := trunc(ry2); SetRect(LeftHandle, x1 - offset1, y1 - offset1, x1 + offset2, y1 + offset2); with info^.RoiRect do begin xcenter := left + (right - left) div 2; ycenter := top + (bottom - top) div 2; end; SetRect(MiddleHandle, xcenter - offset1, ycenter - offset1, xcenter + offset2, ycenter + offset2); SetRect(RightHandle, x2 - offset1, y2 - offset1, x2 + offset2, y2 + offset2); end; procedure DrawROI; var tRect: rect; RoiHandle, LeftHandle, MiddleHandle, RightHandle: rect; psize: integer; StartTicks: LongInt; SaveGDevice: GDHandle; begin with Info^ do begin StartTicks := TickCount; if OpPending then DoOperation(CurrentOp); SaveGDevice := GetGDevice; SetGDevice(osGDevice); SetPort(GrafPtr(Info^.osPort)); PenNormal; if ScaleToFitWindow then if (magnification < 1.0) and (magnification <> 0.0) then begin psize := round(1.0 / magnification + 1.5); PenSize(psize, psize); end; if not ((MouseState = DownInRoi) and OpPending) then if PixMapSize <= UndoBufSize then begin pmForeColor(BlackIndex); pmBackColor(WhiteIndex); case RoiType of RectRoi: with RoiRect do begin SetRect(RoiHandle, right - RoiHandleSize, bottom - RoiHandleSize, right, bottom); if ((right - left) > RoiHandleSize) and ((bottom - top) > RoiHandleSize) then PaintRect(RoiHandle); end; LineRoi: if Magnification <= 2.0 then begin GetLineHandles(LeftHandle, MiddleHandle, RightHandle); PaintRect(LeftHandle); if LineWidth < 4 then PaintRect(MiddleHandle); PaintRect(RightHandle); pmForeColor(WhiteIndex); FrameRect(LeftHandle); if LineWidth < 4 then FrameRect(MiddleHandle); FrameRect(RightHandle); pmForeColor(BlackIndex); end; otherwise end; PatIndex := (PatIndex + 1) mod 8; PenPat(pat[PatIndex]); FrameRgn(roiRgn); pmForeColor(ForegroundIndex); pmBackColor(BackgroundIndex); end; if PixMapSize > UndoBufSize then begin if magnification < 1.0 then PenSize(2, 2); PatIndex := (PatIndex + 1) mod 8; PenPat(pat[PatIndex]); PenMode(PatXor); FrameRgn(roiRgn); if MouseState = DownInRoi then begin UnionRect(RoiRect, OldRoiRect, tRect); UpdateScreen(tRect); end else UpdateScreen(RoiRect); FrameRgn(roiRgn); end else begin tRect := RoiRect; if MouseState = DownInRoi then UnionRect(RoiRect, OldRoiRect, tRect) else if RoiNudged then begin tRect := RoiRect; RoiNudged := false; end; if RoiType = LineRoi then InsetRect(tRect, -RoiHandleSize * 2, -RoiHandleSize * 2) else InsetRect(tRect, -2, -2); UpdateScreen(tRect); UndoRoi; {Erase offscreen ROI} end; RoiUpdateTime := TickCount - StartTicks; end; {with} SetGDevice(SaveGDevice); end; procedure MoveLineEndPoint (osloc: point); var deltax, deltay: real; begin with info^, osloc, info^.RoiRect do begin if h < 0 then h := 0; if h > PicRect.right then h := PicRect.right; if v < 0 then v := 0; if v > PicRect.bottom then v := PicRect.bottom; if RoiMode = LeftEndMode then begin LX1 := h; LY1 := v; LX2 := left + LX2; LY2 := top + LY2; end else begin LX2 := h; LY2 := v; LX1 := left + LX1; LY1 := top + LY1; end; if ShiftKeyDown then begin deltax := LX2 - LX1; deltay := LY2 - LY1; if abs(deltax) > abs(deltay) then begin if RoiMode = LeftEndMode then LY2 := LY1 else LY1 := LY2 end else begin if RoiMode = LeftEndMode then LX2 := LX1 else LX1 := LX2 end; end; {if ShiftKeyDown} MakeRegion; osMouseDownLoc := osloc; RoiUpdateTime := 0; Show3Values(h, v, MyGetPixel(h, v)); end; end; procedure MoveRoi (osloc: point); var dh, dv: integer; begin with info^, info^.RoiRect, osloc do begin dh := h - osMouseDownLoc.h; dv := v - osMouseDownLoc.v; OldRoiRect := RoiRect; if RoiType = LineRoi then if (RoiMode = LeftEndMode) or (RoiMode = RightEndMode) then begin MoveLineEndPoint(osloc); exit(MoveRoi); end; if RoiMode = MoveMode then begin if RoiMovementState = Constrained then begin if dv <> 0 then RoiMovementState := ConstrainedV else if dh <> 0 then RoiMovementState := ConstrainedH end; if RoiMovementState = ConstrainedH then dv := 0 else if RoiMovementState = ConstrainedV then dh := 0; if not OpPending then begin if left + dh < 0 then dh := -left; if top + dv < 0 then dv := -top; end; end; if not OpPending then begin if right + dh > PicRect.right then dh := PicRect.right - right; if bottom + dv > PicRect.bottom then dv := PicRect.bottom - bottom; end; if RoiMode = StretchMode then begin measuring := false; DrawLabels('Width:', 'Height:', ''); if h > left then begin right := right + dh; if right < (left + 1) then right := left + 1; if (right - h) > 5 then right := h + 2; end else right := left + 1; if v > top then begin bottom := bottom + dv; if bottom < (top + 1) then bottom := top + 1; if (bottom - v) > 5 then bottom := v + 2; end else bottom := top + 1; Show3Values(right - left, bottom - top, -1); MakeRegion; end else begin OffsetRgn(roiRgn, dh, dv); Show3Values(left, top, MyGetPixel(left, top)); end; RoiRect := roiRgn^^.rgnBBox; osMouseDownLoc := osloc; RoiUpdateTime := 0; {Forces ROI outline to be redrawn} end; {with Info} end; procedure ShowHistogramValues (GrayLevel: LongInt); var hstart, vstart, ivalue: integer; begin hstart := InfoHStart; vstart := InfoVStart; SetPort(InfoWindow); TextSize(9); TextFont(Monaco); TextMode(SrcCopy); MoveTo(xValueLoc, vstart); with info^ do if DensityCalibrated then begin if InvertingCalibrationFunction then DrawReal(cvalue[255 - GrayLevel], 8, 2) else DrawReal(cvalue[GrayLevel], 8, 2); DrawString(' ('); DrawLong(GrayLevel); DrawString(' )'); end else DrawLong(GrayLevel); DrawString(' '); MoveTo(yValueLoc, vstart + 10); if InvertingCalibrationFunction then DrawLong(histogram[255 - GrayLevel]) else DrawLong(histogram[GrayLevel]); DrawString(' '); end; procedure DoPlotCursor (loc: point; kind: integer); var xscale, angle: extended; xvalue, xinc, yinc: integer; pt: point; begin DrawLabels('X:', 'Y:', ''); SetCursor(ToolCursor[SelectionTool]); SetPort(PlotWindow); GlobalToLocal(loc); xscale := PlotCount / (PlotWidth - PlotRightMargin - PlotLeftMargin); xvalue := trunc((loc.h - PlotLeftMargin) * xscale); if (xvalue < 0) or (xvalue >= PlotCount) then exit(DoPlotCursor); Show2PlotValues(xvalue, PlotData^[xvalue]); if (kind = CalibrationPlotKind) or (info^.RoiType <> LineRoi) then exit(DoPlotCursor); if button and (info <> NoInfo) then with loc do begin SetPort(info^.wptr); PenMode(PatXor); PenSize(1, 1); angle := (PlotAngle / 180.0) * pi; xinc := round(cos(angle) * xvalue); yinc := round(-sin(angle) * xvalue); h := PlotStart.h + xinc; v := PlotStart.v + yinc; OffscreenToScreen(loc); MoveTo(h - 7, v); LineTo(h + 7, v); MoveTo(h, v - 7); LineTo(h, v + 7); wait(2); MoveTo(h - 7, v); LineTo(h + 7, v); MoveTo(h, v - 7); LineTo(h, v + 7); end; end; procedure SelectCursor; var loc, osloc, gloc: point; where, kind, i, color, x, y, margin: integer; WhichWindow: WindowPtr; MouseInRoi: boolean; fwptr: WindowPtr; CalValue: extended; RoiStretchHandle, LeftHandle, MiddleHandle, RightHandle: rect; MovingRoi: boolean; pvalue: integer; begin if PasteControl <> nil then begin fwptr := FrontWindow; if fwptr <> nil then if WindowPeek(fwptr)^.WindowKind <> PasteControlKind then BringToFront(PasteControl); end; SetPort(ScreenPort); GetMouse(gloc); loc := gloc; where := FindWindow(gloc, WhichWindow); if WhichWindow = nil then begin InitCursor; exit(SelectCursor) end; kind := WindowPeek(WhichWindow)^.WindowKind; if kind < 0 then exit(SelectCursor); {System Window} if where <> InContent then begin InitCursor; exit(SelectCursor) end; case kind of PicKind: begin if Info = NoInfo then begin InitCursor; exit(SelectCursor) end; SetPort(info^.wptr); GlobalToLocal(loc); osloc := loc; ScreenToOffscreen(osloc); MovingRoi := false; with info^ do begin SelectionMode := NewSelection; if RoiShowing and ((isSelectionTool) or (CurrentTool = Wand)) and (currentTool <> LineTool) then begin if OptionKeyDown then SelectionMode := SubSelection else if ControlKeyDown or (ShiftKeyDown and (CurrentTool <> OvalSelectionTool) and (CurrentTool <> SelectionTool)) then SelectionMode := AddSelection; end; if RoiShowing and (SelectionMode = NewSelection) then begin MouseInRoi := PtInRgn(osloc, roiRgn); if RoiType = LineRoi then begin GetLineHandles(LeftHandle, MiddleHandle, RightHandle); if magnification <= 2.0 then begin InsetRect(LeftHandle, -2, -2); InsetRect(MiddleHandle, -2, -2); InsetRect(RightHandle, -2, -2); end; MouseInRoi := MouseInRoi or PtInRect(osloc, LeftHandle) or MouseInRoi or PtInRect(osloc, MiddleHandle) or MouseInRoi or PtInRect(osloc, RightHandle); end; end else MouseInRoi := false end; {with} if MouseInRoi or (MouseState = DownInRoi) then begin if MouseState = NotInRoi then MouseState := InRoi; InitCursor; if button then begin if MouseState = InRoi then begin if OpPending and (CurrentOp <> PasteOp) then SetupUndo; MouseState := DownInRoi; osMouseDownLoc := osloc; with info^ do case RoiType of RectRoi: begin if magnification > 1.0 then margin := 0 else margin := 2; with RoiRect do SetRect(RoiStretchHandle, right - RoiHandleSize - margin, bottom - RoiHandleSize - margin, right, bottom); if PtInRect(osloc, RoiStretchHandle) then RoiMode := StretchMode else RoiMode := MoveMode; end; LineRoi: if PtInRect(osloc, LeftHandle) then RoiMode := LeftEndMode else if PtInRect(osloc, RightHandle) then RoiMode := RightEndMode else RoiMode := MoveMode; otherwise end; {case} if ShiftKeyDown then RoiMovementState := Constrained else RoiMovementState := Unconstrained; end; MoveRoi(osloc); MovingRoi := true; end else MouseState := InRoi end else begin MouseState := NotInRoi; if SpaceBarDown and (CurrentTool <> TextTool) then SetCursor(ToolCursor[Grabber]) else if (SelectionMode = AddSelection) and (CurrentTool = Wand) then SetCursor(WandPlusCursor) else if (SelectionMode = SubSelection) and (CurrentTool = Wand) then SetCursor(WandMinusCursor) else if SelectionMode = AddSelection then SetCursor(CrossPlusCursor) else if SelectionMode = SubSelection then SetCursor(CrossMinusCursor) else if (CurrentTool = MagnifyingGlass) and OptionKeyDown then SetCursor(GlassMinusCursor) else SetCursor(ToolCursor[CurrentTool]); end; if not MovingRoi then begin if CurrentTool = PickerTool then DrawLabels('X:', 'Y:', 'RGB:') else DrawLabels('X:', 'Y:', 'Value:'); with osloc do begin if Digitizing then pvalue := GetFGPixel(h, v) else pvalue := MyGetPixel(h, v); Show3Values(h, v, pvalue); end; end; end; HistoKind: begin DrawLabels('Level:', 'Count:', ''); SetCursor(ToolCursor[SelectionTool]); SetPort(HistoWindow); GlobalToLocal(loc); ShowHistogramValues(loc.h); end; ProfilePlotKind, CalibrationPlotKind: DoPlotCursor(loc, kind); LUTKind: begin if info^.DensityCalibrated then DrawLabels('Index:', 'Value:', ' RGB:') else DrawLabels('Index:', ' RGB:', ''); SetPort(LUTWindow); GlobalToLocal(loc); if (CurrentTool = LutTool) or (CurrentTool = Wand) then begin if loc.v < 256 then SetCursor(LUTCursor) else InitCursor end else SetCursor(PickerCursor); if loc.v < 256 then begin ShowRGBValues(loc.v); end else begin color := 0; for i := 1 to nExtraColors + 2 do if PtInRect(loc, ExtraColorsRect[i]) then Color := ExtraColorsEntry[i]; ShowRGBValues(color); end; end; MapKind: if OptionKeyDown then SetCursor(ToolCursor[SelectionTool]) else SetCursor(gmCursor); TextKind: begin TextInfo := TextInfoPtr(WindowPeek(WhichWindow)^.RefCon); if TextInfo <> nil then with TextInfo^ do begin SetPort(TextWindowPtr); GlobalToLocal(loc); TEIdle(TextTE); with TextWindowPtr^.portRect do begin if (loc.h < (right - ScrollBarWidth)) and (loc.v < (bottom - ScrollBarWidth)) then SetCursor(ToolCursor[TextTool]) else InitCursor; end; end; end; otherwise InitCursor; end; {case} end; procedure CloseAll; var i, j, result: integer; WPeek, NextWPeek: WindowPeek; ignore: boolean; begin InitCursor; WPeek := WindowPeek(FrontWindow); StopDigitizing; while wpeek <> nil do begin NextWPeek := WPeek^.NextWindow; case wPeek^.WindowKind of PicKind: begin Info := pointer(WPeek^.RefCon); result := CloseAWindow(info^.wptr); if not CommandPeriod then for j := 1 to 2 do ignore := HandleEvents; if result = cancel then begin ActivateWindow; finished := false; exit(CloseAll) end; end; TextKind: begin result := CloseAWindow(WindowPtr(wPeek)); if result = cancel then begin finished := false; exit(CloseAll) end; end; otherwise ; end; {case} wpeek := NextWPeek; end; end; procedure DoStartup; {Process Finder startup information} var message, ndocs, err, i, j: integer; DocInfo: AppFile; DefaultPalette, OpenedOK: boolean; PaletteName, OutlineName: str255; PaletteFile, OutlineFile: boolean; ignore, PrintDocs: boolean; procedure PrintDocument; var i: integer; begin WhatToPrint := PrintImage; if PrintOptionsSet then Print(false) else begin Print(true); PrintOptionsSet := true end; DoClose; for i := 1 to 10 do ignore := HandleEvents; end; begin for j := 1 to 10 do ignore := HandleEvents; PrintOptionsSet := false; PaletteFile := false; OutlineFile := false; CountAppFiles(message, ndocs); PrintDocs := message = appPrint; if ndocs >= 1 then for i := 1 to ndocs do begin GetAppFiles(i, DocInfo); with DocInfo do begin if ftype = 'ICOL' then begin PaletteFile := true; PaletteName := docinfo.fname; ClrAppFiles(i) end; if fType = 'IPIC' then begin WhatToOpen := OpenImage; OpenedOK := OpenFile(fName, vRefNum); for j := 1 to 10 do ignore := HandleEvents; ClrAppFiles(i); if not OpenedOK then exit(DoStartup); if PrintDocs then PrintDocument; end; if fType = 'TIFF' then begin WhatToOpen := OpenTIFF; OpenedOK := OpenFile(fName, vRefNum); for j := 1 to 10 do ignore := HandleEvents; ClrAppFiles(i); if not OpenedOK then exit(DoStartup); if PrintDocs then PrintDocument; end; if fType = 'PICT' then begin OpenedOK := OpenPICT(fName, vRefNum, false); for j := 1 to 10 do ignore := HandleEvents; ClrAppFiles(i); if not OpenedOK then exit(DoStartup); if PrintDocs then PrintDocument; end; if fType = 'PICS' then begin OpenedOK := OpenPICS(fName, vRefNum); for j := 1 to 10 do ignore := HandleEvents; ClrAppFiles(i); if not OpenedOK then exit(DoStartup); end; if ftype = 'Iout' then begin OutlineFile := true; OutlineName := docinfo.fname; ClrAppFiles(i) end; if fType = 'TEXT' then begin OpenedOK := OpenTextFile(fName, vRefNum); ClrAppFiles(i); if not OpenedOK then exit(DoStartup); end; end; {with} end; if PaletteFile then OpenColorTable(PaletteName, DocInfo.vRefNum); if OutlineFile then OpenOutline(OutlineName, DocInfo.vRefNum); end; procedure LoadDefaultMacros; {Looks for a text file named "Image Macros" in the same folder as} {Image, and, if found, loads the macros contained in it.} var err: OSErr; LaunchRefNum: integer; FinderInfo: FInfo; id: LongInt; begin err := GetVol(nil, LaunchRefNum); if err = noerr then err := GetFInfo('Image Macros', LaunchRefNum, FinderInfo); if err = NoErr then begin LoadMacrosFromFile('Image Macros', LaunchRefNum); UnloadSeg(@LoadMacros); end; end; procedure Shutdown; var AlertID: integer; begin if (UnsavedResults and (mCount > 10)) or (UnsavedResults and (ResultsWindow <> nil)) then begin InitCursor; AlertID := alert(500, nil); if AlertID = CancelResetID then begin finished := false; exit(Shutdown) end; end; CloseAll; if finished then ConvertClipboard; end; begin Init; {InitUserMacros;} SetupMenus; GetSettings; AllocateBuffers; AllocateArrays; ConvertSystemClipboard; DoStartup; LoadDefaultMacros; FindPlugIns; UnloadSeg(@Init); {InitUser;} repeat if not HandleEvents then if info^.RoiShowing and (RoiUpdateTime < 30) then DrawRoi; ShowInsertionPoint; SelectCursor; if Digitizing then begin CaptureAndDisplayFrame; if ContinuousHistogram then ShowContinuousHistogram; end; if Finished then Shutdown; until finished; CloseSerialPorts; isOK := LoadCLUTResource(AppleDefaultCLUT); RestoreScreen; {Force Finder to redraw color icons} end.